home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap09 / howto06 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-11  |  79.4 KB  |  2,371 lines
  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl,
  8.   {Winsock,} CCWSock, CCICCInf, CCICCPrf, IniFiles, Gauges;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : string; { Connection profile; used in lists }
  15.     CIPAddress : string; { Dotted character IP Address       }
  16.     CUserName  : string; { Login name to site; can be anonym }
  17.     CPassword  : string; { Password; won't be shown          }
  18.     CStartDir  : string; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   TCCINetCCForm = class(TForm)
  23.     Panel1: TPanel;
  24.     Panel2: TPanel;
  25.     Panel3: TPanel;
  26.     Panel4: TPanel;
  27.     Panel5: TPanel;
  28.     Panel6: TPanel;
  29.     ListBox1: TListBox;
  30.     Panel7: TPanel;
  31.     SpeedButton1: TSpeedButton;
  32.     SpeedButton2: TSpeedButton;
  33.     ListBox2: TListBox;
  34.     ComboBox1: TComboBox;
  35.     Button1: TButton;
  36.     Memo1: TMemo;
  37.     SpeedButton4: TSpeedButton;
  38.     SpeedButton5: TSpeedButton;
  39.     SpeedButton3: TSpeedButton;
  40.     Panel8: TPanel;
  41.     Label1: TLabel;
  42.     Label2: TLabel;
  43.     ComboBox2: TComboBox;
  44.     Label3: TLabel;
  45.     ComboBox3: TComboBox;
  46.     Label4: TLabel;
  47.     Label5: TLabel;
  48.     OpenDialog1: TOpenDialog;
  49.     SaveDialog1: TSaveDialog;
  50.     PrintDialog1: TPrintDialog;
  51.     PrinterSetupDialog1: TPrinterSetupDialog;
  52.     FindDialog1: TFindDialog;
  53.     ReplaceDialog1: TReplaceDialog;
  54.     Gauge1: TGauge;
  55.     MainMenu1: TMainMenu;
  56.     Network1: TMenuItem;
  57.     ViewWinsockInfo1: TMenuItem;
  58.     Description1: TMenuItem;
  59.     SystemStatus1: TMenuItem;
  60.     VendorSpecific1: TMenuItem;
  61.     N1: TMenuItem;
  62.     ProgressInfo1: TMenuItem;
  63.     ViewInEditWindow1: TMenuItem;
  64.     ViewInStatusLine1: TMenuItem;
  65.     SaveToFile1: TMenuItem;
  66.     N2: TMenuItem;
  67.     Exit1: TMenuItem;
  68.     Services1: TMenuItem;
  69.     IPAddress1: TMenuItem;
  70.     EMail1: TMenuItem;
  71.     FTP1: TMenuItem;
  72.     UsenetNws1: TMenuItem;
  73.     Files1: TMenuItem;
  74.     Load1: TMenuItem;
  75.     Save1: TMenuItem;
  76.     Encoding1: TMenuItem;
  77.     UUDecode1: TMenuItem;
  78.     MIMEDecode1: TMenuItem;
  79.     UUEncode1: TMenuItem;
  80.     MIMEEncode1: TMenuItem;
  81.     Edit1: TMenuItem;
  82.     Cut1: TMenuItem;
  83.     Copy1: TMenuItem;
  84.     CopytoFile1: TMenuItem;
  85.     Paste1: TMenuItem;
  86.     PastefromFile1: TMenuItem;
  87.     EMail2: TMenuItem;
  88.     CheckMail1: TMenuItem;
  89.     CreateNewMessage1: TMenuItem;
  90.     ReplyToCurrentMessage1: TMenuItem;
  91.     SendCurrentMessage1: TMenuItem;
  92.     SendQueue1: TMenuItem;
  93.     MailServers1: TMenuItem;
  94.     Mailboxes1: TMenuItem;
  95.     Correspondents1: TMenuItem;
  96.     TrashMarkedMessages1: TMenuItem;
  97.     EmptyTrash1: TMenuItem;
  98.     ExitEMailRequired1: TMenuItem;
  99.     FTP2: TMenuItem;
  100.     ConnectToSite1: TMenuItem;
  101.     Disconnect1: TMenuItem;
  102.     UploadMarked1: TMenuItem;
  103.     ASCII1: TMenuItem;
  104.     Binary1: TMenuItem;
  105.     DownloadMarked1: TMenuItem;
  106.     ASCII2: TMenuItem;
  107.     ToFile1: TMenuItem;
  108.     ToDisplay1: TMenuItem;
  109.     Binary2: TMenuItem;
  110.     Directory1: TMenuItem;
  111.     ViewRemoteasText1: TMenuItem;
  112.     ViewasText1: TMenuItem;
  113.     Change1: TMenuItem;
  114.     Create1: TMenuItem;
  115.     Delete3: TMenuItem;
  116.     ChangeLocal1: TMenuItem;
  117.     DeleteRemoteFiles1: TMenuItem;
  118.     FTPSites1: TMenuItem;
  119.     News1: TMenuItem;
  120.     ConnectandUpdate1: TMenuItem;
  121.     Disconnect2: TMenuItem;
  122.     Headers1: TMenuItem;
  123.     RetrieveMarked1: TMenuItem;
  124.     RetrieveAll1: TMenuItem;
  125.     CheckNewNews1: TMenuItem;
  126.     GetMarked1: TMenuItem;
  127.     Article1: TMenuItem;
  128.     NewArticle1: TMenuItem;
  129.     FollowupArticle1: TMenuItem;
  130.     PutinQueue1: TMenuItem;
  131.     Post1: TMenuItem;
  132.     CurrentArticle1: TMenuItem;
  133.     EntireQueue1: TMenuItem;
  134.     NewsServers1: TMenuItem;
  135.     SubscribedNewsgroups1: TMenuItem;
  136.     Trash1: TMenuItem;
  137.     AllReadArticles1: TMenuItem;
  138.     AllMarkedArticles1: TMenuItem;
  139.     AllAvailableArticles1: TMenuItem;
  140.     DownloadActiveNewsgroups1: TMenuItem;
  141.     Preferences1: TMenuItem;
  142.     EMail3: TMenuItem;
  143.     FTP3: TMenuItem;
  144.     News2: TMenuItem;
  145.     Paths1: TMenuItem;
  146.     procedure Exit1Click(Sender: TObject);
  147.     procedure FormCreate(Sender: TObject);
  148.     procedure FormDestroy(Sender: TObject);
  149.     procedure Description1Click(Sender: TObject);
  150.     procedure SystemStatus1Click(Sender: TObject);
  151.     procedure VendorSpecific1Click(Sender: TObject);
  152.     procedure ViewInEditWindow1Click(Sender: TObject);
  153.     procedure ViewInStatusLine1Click(Sender: TObject);
  154.     procedure SaveToFile1Click(Sender: TObject);
  155.     procedure IPAddress1Click(Sender: TObject);
  156.     procedure FTP1Click(Sender: TObject);
  157.     procedure FormResize(Sender: TObject);
  158.     procedure FTPSites1Click(Sender: TObject);
  159.     procedure FTP3Click(Sender: TObject);
  160.     procedure ConnectToSite1Click(Sender: TObject);
  161.     procedure Button1Click(Sender: TObject);
  162.     procedure ViewasText1Click(Sender: TObject);
  163.     procedure Disconnect1Click(Sender: TObject);
  164.     procedure ToDisplay1Click(Sender: TObject);
  165.     procedure Change1Click(Sender: TObject);
  166.     procedure ChangeLocal1Click(Sender: TObject);
  167.     procedure ListBox1DblClick(Sender: TObject);
  168.     procedure ListBox2DblClick(Sender: TObject);
  169.   private
  170.     { Private declarations }
  171.   public
  172.     { Public declarations }
  173.     procedure EnableFTPMenus;
  174.     procedure DisableFTPMenus;
  175.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  176.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  177.     procedure DoFTPDisconnect;
  178.     procedure ReadIniData;
  179.     procedure WriteIniData;
  180.     procedure LoadFTPSiteFile;
  181.     procedure SaveFTPSiteFile;
  182.     procedure SetupFTPSiteLists;
  183.     procedure AddNullTermTextToMemo( TheTextToAdd   : string;
  184.                                      TheMemoToAddTo : TMemo   );
  185.     function AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
  186.     procedure SetHGCursors;
  187.     procedure SetNormalCursors;
  188.     procedure AddProgressText( WhatText : string );
  189.     procedure ShowProgressText( WhatText : string );
  190.     procedure ShowProgressErrorText( WhatText : string );
  191.     procedure SocketsErrorOccurred( Sender     : TObject;
  192.                                      ErrorCode  : Integer;
  193.                                      TheMessage : string   );
  194.   end;
  195.   { Component to hold FTP handling capabilities }
  196.   TFTPComponent = class( TWinControl )
  197.   public
  198.     FTPCommandInProgress ,
  199.     Connection_Established : Boolean;
  200.     Socket1 : TCCSocket;
  201.     Socket2 : TCCSocket;
  202.     constructor Create( AOwner : TComponent ); override;
  203.     destructor Destroy; override;
  204.     function GetTotalBytesToReceive( TheString : string ) : Longint;
  205.     function StripBrackets( TheString : string ) : string;
  206.     function GetShortPathname( TheString : string ) : string;
  207.     function GetWin16FileName( InputName : string ) : string;
  208.     function GetRemoteWorkingDirectory( var RemoteDir : string ) : Boolean;
  209.     function SetRemoteDirectory( TheDir : string ) : Boolean;
  210.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  211.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  212.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  213.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  214.               : Boolean;
  215.     function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
  216.     function GetRemoteDirectoryListingToMemo : Boolean;
  217.     function GetLocalDirectoryAndListing( var TheString : string;
  218.                                               TheListBox : TListBox )
  219.               : Boolean;
  220.     function GetUNIXTextString( var StringIn : string ) : string;
  221.     procedure ReceiveASCIIRemoteFileToMemo( RemoteName : string );
  222.     function GetListeningPort : Integer;
  223.     procedure GetFileNameFromUNIXFileName( var TheName : string );
  224.     function Disconnect : Boolean;
  225.     function DoCStyleFormat(       TheText      : string;
  226.                              const TheArguments : array of const ) : string;
  227.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  228.     function GetQuotedString( TheString : string ) : string;
  229.     procedure AddProgressText( WhatText : string );
  230.     procedure ShowProgressText( WhatText : string );
  231.     procedure ShowProgressErrorText( WhatText : string );
  232.     function GetFTPServerResponse( var ResponseString : string ) : Integer;
  233.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  234.                                      ErrorCode  : Integer;
  235.                                      TheMessage : string   );
  236.     function PerformFTPCommand(
  237.                     TheCommand   : string;
  238.               const TheArguments : array of const ) : Integer;
  239.   end;
  240. const
  241.   POV_MEMO                 = 1; { Progress to the Memo           }
  242.   POV_STAT                 = 2; { Progress to the status caption }
  243.   FTP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  244.   FTP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  245.   FTP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  246.   FTP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  247.   FTP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  248.  
  249. var
  250.   CCINetCCForm         : TCCINetCCForm;
  251.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  252.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  253.   ProgressList         : TStringList;    { Used to hold progress text info }
  254.   ProgressFileName     : string;         { Used to hold progress file name }
  255.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  256.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  257.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  258.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  259.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  260.   MailPath             : string;         { Used for path to Mail Files     }
  261.   NewsPath             : string;         { Used for path to News Files     }
  262.   WWWPath              : string;         { Used for path to WWW Files      }
  263.   FTPPath              : string;         { Used for path to FTP Files      }
  264.   CurrentPassWordString : string;        { Used to hold login id for anons }
  265.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  266.   CurrentRealPWString   : string;        { Used to hold a real password    }
  267.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  268.   TheLine ,
  269.   HolderLine ,
  270.   GlobalTextBuffer      : string;
  271.   TheAnonRedialVector ,
  272.   DefaultDownloadVector : Integer;
  273.   LeftoverText          : string;
  274.   LeftoversOnTable      : Boolean;
  275.   FileNameToXFer        : string;
  276.  
  277. implementation
  278.  
  279. {$R *.DFM}
  280.  
  281. { This is the FTP component constructor; it creates 2 sockets }
  282. constructor TFTPComponent.Create( AOwner : TComponent );
  283. begin
  284.   { do inherited create }
  285.   inherited Create( AOwner );
  286.   { Create sockets, put in their parents, and error procs }
  287.   Socket1 := TCCSocket.Create( Self );
  288.   Socket1.Parent := Self;
  289.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  290.   Socket2 := TCCSocket.Create( Self );
  291.   Socket2.Parent := Self;
  292.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  293.   { Set up booleans }
  294.   Connection_Established := false;
  295.   FTPCommandInProgress := false;
  296. end;
  297.  
  298. { This is the FTP component destructor; it frees 2 sockets }
  299. destructor TFTPComponent.Destroy;
  300. begin
  301.   { Free the sockets }
  302.   Socket1.Free;
  303.   Socket2.Free;
  304.   { and call inherited }
  305.   inherited Destroy;
  306. end;
  307.  
  308. function TFTPComponent.GetShortPathname( TheString : string ) : string;
  309. var HoldingString : string;
  310. begin
  311.   HoldingString := Copy( TheString , 1 , 3 );
  312.   HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  313.   Result := HoldingString;
  314. end;
  315.  
  316. function TFTPComponent.StripBrackets( TheString : string ) : string;
  317. var HoldingString : string;
  318.     HoldingPosition : Integer;
  319. begin
  320.   HoldingPosition := Pos( '[' , TheString );
  321.   if HoldingPosition = 0 then
  322.   begin
  323.     Result := TheString;
  324.     exit;
  325.   end
  326.   else
  327.   begin
  328.     HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
  329.     HoldingPosition := Pos( ']' , HoldingString );
  330.     if HoldingPosition = 0 then
  331.     begin
  332.       Result := HoldingString;
  333.       exit;
  334.     end
  335.     else
  336.     begin
  337.       HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
  338.       Result := HoldingString;
  339.       exit;
  340.     end;
  341.   end;
  342. end;
  343.  
  344. { This function takes a UNIX filespec and turns it into a Win16 filename }
  345. function TFTPComponent.GetWin16FileName( InputName : string ) : string;
  346. var WorkingString ,
  347.     HoldingString   : string; { Holding string }
  348. begin
  349.   WorkingString := ExtractFileExt( InputName );
  350.   if WorkingString = '' then
  351.   begin
  352.     if Length( InputName ) > 8 then
  353.      WorkingString := Copy( InputName , 1 , 8 ) else
  354.       WorkingString := InputName;
  355.   end
  356.   else
  357.   begin
  358.     if Length( WorkingString ) > 4 then
  359.      WorkingString := Copy( WorkingString , 1 , 4 );
  360.     HoldingString :=
  361.      Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
  362.     if Length( HoldingString ) > 8 then
  363.      HoldingString := Copy( HoldingString , 1 , 8 );
  364.     if HoldingString = '' then
  365.     begin
  366.       { Dot file }
  367.       HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
  368.       WorkingString := HoldingString;
  369.     end
  370.     else WorkingString := HoldingString + WorkingString;
  371.   end;
  372.   Result := WorkingString;
  373. end;
  374.  
  375.  
  376. { This function strips out the FTP response for bytes to send }
  377. function TFTPComponent.GetTotalBytesToReceive( TheString : string ) : Longint;
  378. var
  379.   LeftPosition ,
  380.   RightPosition  : Integer;
  381.   TempString     : string;
  382. begin
  383.   LeftPosition := Pos( '(' , TheString );
  384.   TempString := Copy( TheString ,
  385.                       LeftPosition + 1 , 255 );
  386.   RightPosition := Pos( ' ' , TempString );
  387.   if (( LeftPosition = 0 ) or ( RightPosition = 0 )) then
  388.   begin
  389.     Result := 0;
  390.     exit;
  391.   end;
  392.   if RightPosition <> 0 then
  393.     TempString := Copy( TempString , 1 , RightPosition - 1  );
  394.   try
  395.     Result := StrToInt( TempString );
  396.   except
  397.     on EConvertError do Result := 0;
  398.   end;
  399. end;
  400.  
  401. procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  402. begin
  403.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  404. end;
  405.  
  406. { This sends FTP progress text to the Inet form }
  407. procedure TFTPComponent.AddProgressText( WhatText : string );
  408. begin
  409.   CCInetCCForm.AddProgressText( WhatText );
  410. end;
  411.  
  412. { This sends FTP progress text to the Inet form }
  413. procedure TFTPComponent.ShowProgressText( WhatText : string );
  414. begin
  415.   CCInetCCForm.ShowProgressText( WhatText );
  416. end;
  417.  
  418. { This procedure receives a binary remote file }
  419. procedure TFTPComponent.ReceiveASCIIRemoteFileToMemo( RemoteName : string );
  420. var TheReturnString : string;  { Internal string holder }
  421.     TheResult       : Integer; { Internal int holder    }
  422.     InputString     : string;
  423.     Through ,
  424.     Finished        : Boolean;
  425.     TotalBytesSent ,
  426.     FileToGetSize    : Longint;
  427. begin
  428.   TheReturnString :=
  429.    DoCStyleFormat( 'TYPE A' ,
  430.     [ nil ] );
  431.   { Put result in progress and status line }
  432.   AddProgressText( TheReturnString );
  433.   ShowProgressText( TheReturnString );
  434.   { Send Password sequence }
  435.   FTPCommandInProgress := false;
  436.   TheResult := PerformFTPCommand( 'TYPE A',
  437.                                   [ nil ] );
  438.   if TheResult <> FTP_STATUS_PRELIMINARY then
  439.   begin
  440.     FTPCommandInProgress := false;
  441.     exit;
  442.   end;
  443.   repeat
  444.     TheResult := GetFTPServerResponse( TheReturnString );
  445.     { Put result in progress and status line }
  446.     AddProgressText( TheReturnString );
  447.     ShowProgressText( TheReturnString );
  448.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  449.   FTPCommandInProgress := false;
  450.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  451.   begin
  452.     { Do clever C formatting trick }
  453.     TheReturnString :=
  454.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  455.       [ nil ] );
  456.     { Put result in progress and status line }
  457.     AddProgressText( TheReturnString );
  458.     ShowProgressErrorText( TheReturnString );
  459.     { leave }
  460.     exit;
  461.   end
  462.   else
  463.   begin
  464.     { Set up socket 2 for listening }
  465.     Socket2.AsynchMode := False;
  466.     Socket2.NonAsynchTimeoutValue := 60;
  467.     { do a listen and send command to server that this is receipt socket }
  468.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  469.     begin
  470.       Socket2.CCSockCancelListen;
  471.       exit;
  472.     end;
  473.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  474.     TheReturnString :=
  475.      DoCStyleFormat( 'RETR %s' ,
  476.       [ RemoteName ] );
  477.     { Put result in progress and status line }
  478.     AddProgressText( TheReturnString );
  479.     ShowProgressText( TheReturnString );
  480.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  481.     GetFTPServerResponse( TheReturnString );
  482.     AddProgressText( TheReturnString );
  483.     ShowProgressText( TheReturnString );
  484.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  485.     Socket1.NonAsynchTimeoutValue := 30;
  486.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  487.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  488.     begin
  489.       TheReturnString :=
  490.        DoCStyleFormat( 'Could not obtain remote file!' ,
  491.         [ nil ] );
  492.       { Put result in progress and status line }
  493.       AddProgressText( TheReturnString );
  494.       ShowProgressErrorText( TheReturnString );
  495.       Socket2.CCSockCancelListen;
  496.       exit;
  497.     end;
  498.     Socket2.CCSockAccept;
  499.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  500.     begin
  501.       TheReturnString :=
  502.        DoCStyleFormat( 'Could not establish receive socket!' ,
  503.         [ nil ] );
  504.       { Put result in progress and status line }
  505.       AddProgressText( TheReturnString );
  506.       ShowProgressErrorText( TheReturnString );
  507.       exit;
  508.     end;
  509.     Through := false;
  510.     TotalBytesSent := 0;
  511.     repeat
  512.       TheReturnString := Socket2.StringData;
  513.       if Length( TheReturnString ) = 0 then Through := true;
  514.       if Length( TheReturnString ) > 0 then
  515.       begin
  516.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  517.         UpdateGauge( TotalBytesSent , FileToGetSize );
  518.         { Put result in progress and status line }
  519.         AddProgressText( TheReturnString );
  520.         ShowProgressText( TheReturnString );
  521.       end;
  522.       if GlobalAbortedFlag then
  523.       begin
  524.         Socket1.OutOfBand := 'ABOR'+#13#10;
  525.         repeat
  526.           TheResult := GetFTPServerResponse( TheReturnString );
  527.           { Put result in progress and status line }
  528.           AddProgressText( TheReturnString );
  529.           ShowProgressText( TheReturnString );
  530.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  531.         exit;
  532.       end;
  533.     until Through;
  534.     { cancel listening on second socket and close it }
  535.     Socket2.CCSockCancelListen;
  536.     Socket2.CCSockClose;
  537.     FTPCommandInProgress := false;
  538.     TheResult := PerformFTPCommand( 'TYPE A',
  539.                                     [ nil ] );
  540.     Through := false;
  541.     repeat
  542.       TheResult := GetFTPServerResponse( TheReturnString );
  543.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  544.        Through := true;
  545.       { Put result in progress and status line }
  546.       AddProgressText( TheReturnString );
  547.       ShowProgressText( TheReturnString );
  548.     until (( GlobalAbortedFlag ) or Through );
  549.   end;
  550.   FTPCommandInProgress := false;
  551. end;
  552.  
  553. { This sends FTP progress text to the Inet form }
  554. procedure TFTPComponent.ShowProgressErrorText( WhatText : string );
  555. begin
  556.   CCInetCCForm.ShowProgressErrorText( WhatText );
  557. end;
  558.  
  559. { This is a core function! It performs an FTP command and if no timeout }
  560. { return a preliminary ok.                                              }
  561. function TFTPComponent.PerformFTPCommand(
  562.                  TheCommand        : string;
  563.            const TheArguments      : array of const ) : Integer;
  564. var TheBuffer : string; { Text buffer }
  565. begin
  566.   { If command in progress send back -1 error }
  567.   if FTPCommandInProgress then
  568.   begin
  569.     Result := -1;
  570.     exit;
  571.   end;
  572.   { Set status variable }
  573.   FTPCommandInProgress := True;
  574.   { Set global error code }
  575.   GlobalErrorCode := 0;
  576.   { Format output string }
  577.   TheBuffer := Format( TheCommand , TheArguments );
  578.   { Preset failure code }
  579.   Result := FTP_STATUS_FATAL_ERROR;
  580.   { If invalid socket or no connection abort }
  581.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  582.    exit;
  583.   { Send the buffer plus EOL chars }
  584.   Socket1.StringData := TheBuffer + #13#10;
  585.   { if abort due to timeout or other error exit }
  586.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  587.   { Otherwise return preliminary code }
  588.   Result := FTP_STATUS_PRELIMINARY;
  589. end;
  590.  
  591. { This function gets up to 255 chars of data plus a return code from FTP serv }
  592. function TFTPComponent.GetFTPServerResponse(
  593.           var ResponseString : string ) : Integer;
  594. var
  595.   { Buffer string for response line }
  596.   TheBuffer     : string;
  597.   { Pointer to the response string }
  598.   BufferPointer : array[0..255] of char absolute TheBuffer;
  599.   { Character to check for response code }
  600.   ResponseChar   : char;
  601.   { Pointers into returned string }
  602.   TheIndex ,
  603.   TheLength     : Integer;
  604.   { Control variable }
  605.   LeftoversInPan ,
  606.   Finished      : Boolean;
  607. begin
  608.   { Preset fatal error }
  609.   Result := FTP_STATUS_FATAL_ERROR;
  610.   { Start loop control }
  611.   LeftoversInPan := false;
  612.   Finished := false;
  613.   repeat
  614.     { Do a peek }
  615.     TheBuffer := Socket1.PeekData;
  616.     { If timeout or other error exit }
  617.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  618.     { Find end of line character }
  619.     TheIndex := Pos( #10 , TheBuffer );
  620.     if TheIndex = 0 then
  621.     begin
  622.       TheIndex := Pos( #13 , TheBuffer );
  623.       if TheIndex = 0 then
  624.       begin
  625.         TheIndex := Pos( #0 , TheBuffer );
  626.         if TheIndex = 0 then
  627.         begin
  628.           TheIndex := Length( TheBuffer );
  629.           LeftoversInPan := True;
  630.           LeftoverText := LeftoverText + TheBuffer;
  631.           LeftoversOnTable := false;
  632.         end;
  633.       end;
  634.     end;
  635.     { If an end of line then process the line }
  636.     if TheIndex > 0 then
  637.     begin
  638.       { Get length of string }
  639.       TheLength := TheIndex;
  640.       { Receive actual data }
  641.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  642.                              @BufferPointer[ 1 ] ,
  643.                              TheLength              );
  644.       { Abort if timeout or error }
  645.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  646.       { Put in the length byte }
  647.       BufferPointer[ 0 ] := Chr( TheLength );
  648.       if LeftOversOnTable then
  649.       begin
  650.         LeftOversOnTable := false;
  651.         ResponseString := LeftoverText + TheBuffer;
  652.         TheBuffer := ResponseString;
  653.         LeftoverText := '';
  654.       end;
  655.       if LeftoversInPan then
  656.       begin
  657.         LeftoversInPan := false;
  658.         LeftoversOnTable := true;
  659.       end;
  660.       { If not a continuation line }
  661.       if TheBuffer[ 4 ] <> '-' then
  662.       begin
  663.         { Get first number character }
  664.         ResponseChar := TheBuffer[ 1 ];
  665.         { Get the value of the number from 1 to 5 }
  666.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  667.         begin
  668.           Finished := true;
  669.           Result := Ord( ResponseChar ) - 48;
  670.         end;
  671.       end
  672.       else
  673.       begin
  674.         { otherwise return preliminary result }
  675.         Finished := true;
  676.         Result := FTP_STATUS_PRELIMINARY;
  677.       end;
  678.     end
  679.     else
  680.     begin
  681.     end;
  682.   until ( Finished and ( not LeftoversOnTable ));
  683.   { Return buffer as response string }
  684.   ResponseString := TheBuffer;
  685. end;
  686.  
  687. { Boilerplate error routine }
  688. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  689.                                                  ErrorCode  : Integer;
  690.                                                  TheMessage : string   );
  691. begin
  692.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  693. end;
  694.  
  695. { This is the FTP components initial connection routine }
  696. function TFTPComponent.EstablishConnection(
  697.           PCRPointer : PConnectionsRecord ) : Boolean;
  698. var TheReturnString : string;  { Internal string holder }
  699.     TheResult       : Integer; { Internal int holder    }
  700. begin
  701.   { Set default FTP Port value }
  702.   Socket1.PortName := '21';
  703.   { Get the ip address from the record }
  704.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  705.   { Set blocking mode }
  706.   Socket1.AsynchMode := False;
  707.   { Clear condition variables }
  708.   GlobalErrorCode := 0;
  709.   GlobalAbortedFlag := false;
  710.   { Actually attempt to connect }
  711.   Socket1.CCSockConnect;
  712.   { Check if connected }
  713.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  714.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  715.   begin { Didn't connect; signal error and abort }
  716.     { Do clever C formatting trick }
  717.     TheReturnString :=
  718.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  719.       [ PCRPointer^.CIPAddress ] );
  720.     { Put result in progress and status line }
  721.     AddProgressText( TheReturnString );
  722.     ShowProgressErrorText( TheReturnString );
  723.     { Signal error }
  724.     Result := False;
  725.     { leave }
  726.     exit;
  727.   end
  728.   else
  729.   begin
  730.     Connection_Established := true;
  731.     { Signal successful connection }
  732.     TheReturnString := DoCStyleFormat(
  733.       'Connected on Local port: %s with IP: %s',
  734.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  735.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  736.     { Put result in progress and status line }
  737.     CCINetCCForm.AddProgressText( TheReturnString );
  738.     CCINetCCForm.ShowProgressText( TheReturnString );
  739.     TheReturnString := DoCStyleFormat(
  740.      'Connected to Remote port: %s with IP: %s',
  741.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  742.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  743.     { Put result in progress and status line }
  744.     CCINetCCForm.AddProgressText( TheReturnString );
  745.     CCINetCCForm.ShowProgressText( TheReturnString );
  746.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  747.      [ Socket1.IPAddressName ]);
  748.     { Put result in progress and status line }
  749.     CCINetCCForm.AddProgressText( TheReturnString );
  750.     CCINetCCForm.ShowProgressText( TheReturnString );
  751.     repeat
  752.       TheResult := GetFTPServerResponse( TheReturnString );
  753.       { Put result in progress and status line }
  754.       AddProgressText( TheReturnString );
  755.       ShowProgressText( TheReturnString );
  756.     until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  757.     if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  758.     begin
  759.       { Do clever C formatting trick }
  760.       TheReturnString :=
  761.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  762.         [ PCRPointer^.CIPAddress ] );
  763.       { Put result in progress and status line }
  764.       AddProgressText( TheReturnString );
  765.       ShowProgressErrorText( TheReturnString );
  766.       { Signal error }
  767.       Result := False;
  768.       { leave }
  769.       exit;
  770.     end
  771.     else Result := true; { Signal no problem }
  772.   end;
  773. end;
  774.  
  775. { This is the FTP components USER login routine }
  776. function TFTPComponent.LoginUser(
  777.           PCRPointer : PConnectionsRecord ) : Boolean;
  778. var TheReturnString : string;  { Internal string holder }
  779.     TheResult       : Integer; { Internal int holder    }
  780. begin
  781.   TheReturnString :=
  782.    DoCStyleFormat( 'USER %s' ,
  783.     [ PCRPointer^.CUserName ] );
  784.   { Put result in progress and status line }
  785.   AddProgressText( TheReturnString );
  786.   ShowProgressText( TheReturnString );
  787.   { Begin login sequence with user name }
  788.   TheResult := PerformFTPCommand( 'USER %s',
  789.                                   [ PCRPointer^.CUserName ] );
  790.   if TheResult <> FTP_STATUS_PRELIMINARY then
  791.   begin
  792.     FTPCommandInProgress := false;
  793.     Result := false;
  794.     exit;
  795.   end;
  796.   repeat
  797.     TheResult := GetFTPServerResponse( TheReturnString );
  798.     { Put result in progress and status line }
  799.     AddProgressText( TheReturnString );
  800.     ShowProgressText( TheReturnString );
  801.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  802.   FTPCommandInProgress := false;
  803.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_CONTINUING )) then
  804.   begin
  805.     { Do clever C formatting trick }
  806.     TheReturnString :=
  807.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  808.       [ PCRPointer^.CIPAddress ] );
  809.     { Put result in progress and status line }
  810.     AddProgressText( TheReturnString );
  811.     ShowProgressErrorText( TheReturnString );
  812.     { Signal error }
  813.     Result := False;
  814.     { leave }
  815.     exit;
  816.   end
  817.   else Result := true; { Signal no problem }
  818. end;
  819.  
  820.  
  821. { This is the FTP components PASSWORD routine }
  822. function TFTPComponent.SendPassword(
  823.           PCRPointer : PConnectionsRecord ) : Boolean;
  824. var TheReturnString : string;  { Internal string holder }
  825.     TheResult       : Integer; { Internal int holder    }
  826. begin
  827.   TheReturnString := 'PASS XXXXXX' + #13#10;
  828.   { Put result in progress and status line }
  829.   AddProgressText( TheReturnString );
  830.   ShowProgressText( TheReturnString );
  831.   { Send Password sequence }
  832.   TheResult := PerformFTPCommand( 'PASS %s',
  833.                                   [ PCRPointer^.CPassword ] );
  834.   if TheResult <> FTP_STATUS_PRELIMINARY then
  835.   begin
  836.     Result := false;
  837.     FTPCommandInProgress := false;
  838.     exit;
  839.   end;
  840.   repeat
  841.     TheResult := GetFTPServerResponse( TheReturnString );
  842.     { Put result in progress and status line }
  843.     AddProgressText( TheReturnString );
  844.     ShowProgressText( TheReturnString );
  845.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  846.   FTPCommandInProgress := false;
  847.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  848.   begin
  849.     { Do clever C formatting trick }
  850.     TheReturnString :=
  851.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  852.       [ PCRPointer^.CIPAddress ] );
  853.     { Put result in progress and status line }
  854.     AddProgressText( TheReturnString );
  855.     ShowProgressErrorText( TheReturnString );
  856.     { Signal error }
  857.     Result := False;
  858.     { leave }
  859.     exit;
  860.   end
  861.   else Result := true; { Signal no problem }
  862. end;
  863.  
  864. { This is the FTP components CWD routine }
  865. function TFTPComponent.SetRemoteStartupDirectory(
  866.           PCRPointer : PConnectionsRecord ) : Boolean;
  867. var TheReturnString : string;  { Internal string holder }
  868.     TheResult       : Integer; { Internal int holder    }
  869. begin
  870.   Result := true;
  871.   if PCRPointer^.CStartDir <> '' then
  872.   begin
  873.     TheReturnString :=
  874.      DoCStyleFormat( 'CWD %s' ,
  875.       [ PCRPointer^.CStartDir ] );
  876.     { Put result in progress and status line }
  877.     AddProgressText( TheReturnString );
  878.     ShowProgressText( TheReturnString );
  879.     { Send Password sequence }
  880.     TheResult := PerformFTPCommand( 'CWD %s',
  881.                                     [ PCRPointer^.CStartDir ] );
  882.     if TheResult <> FTP_STATUS_PRELIMINARY then
  883.     begin
  884.       Result := false;
  885.       FTPCommandInProgress := false;
  886.       exit;
  887.     end;
  888.     repeat
  889.       TheResult := GetFTPServerResponse( TheReturnString );
  890.       { Put result in progress and status line }
  891.       AddProgressText( TheReturnString );
  892.       ShowProgressText( TheReturnString );
  893.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  894.    FTPCommandInProgress := false;
  895.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  896.     begin
  897.       { Do clever C formatting trick }
  898.       TheReturnString :=
  899.        DoCStyleFormat( 'CWD to %s Failed!' ,
  900.         [ PCRPointer^.CStartDir ] );
  901.       { Put result in progress and status line }
  902.       AddProgressText( TheReturnString );
  903.       ShowProgressErrorText( TheReturnString );
  904.       { Signal error }
  905.       Result := False;
  906.       { leave }
  907.       exit;
  908.     end
  909.     else Result := true; { Signal no problem }
  910.   end;
  911. end;
  912.  
  913. { This is the FTP components CWD routine }
  914. function TFTPComponent.SetRemoteDirectory( TheDir : string ) : Boolean;
  915. var TheReturnString : string;  { Internal string holder }
  916.     TheResult       : Integer; { Internal int holder    }
  917. begin
  918.   Result := true;
  919.   if TheDir <> '' then
  920.   begin
  921.     TheReturnString :=
  922.      DoCStyleFormat( 'CWD %s' ,
  923.       [ TheDir ] );
  924.     { Put result in progress and status line }
  925.     AddProgressText( TheReturnString );
  926.     ShowProgressText( TheReturnString );
  927.     { Send Password sequence }
  928.     TheResult := PerformFTPCommand( 'CWD %s',
  929.                                     [ TheDir ] );
  930.     if TheResult <> FTP_STATUS_PRELIMINARY then
  931.     begin
  932.       Result := false;
  933.       FTPCommandInProgress := false;
  934.       exit;
  935.     end;
  936.     repeat
  937.       TheResult := GetFTPServerResponse( TheReturnString );
  938.       { Put result in progress and status line }
  939.       AddProgressText( TheReturnString );
  940.       ShowProgressText( TheReturnString );
  941.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  942.    FTPCommandInProgress := false;
  943.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  944.     begin
  945.       { Do clever C formatting trick }
  946.       TheReturnString :=
  947.        DoCStyleFormat( 'CWD to %s Failed!' ,
  948.         [ TheDir ] );
  949.       { Put result in progress and status line }
  950.       AddProgressText( TheReturnString );
  951.       ShowProgressErrorText( TheReturnString );
  952.       { Signal error }
  953.       Result := False;
  954.       { leave }
  955.       exit;
  956.     end
  957.     else Result := true; { Signal no problem }
  958.   end;
  959. end;
  960.  
  961. { This is the FTP components QUIT routine }
  962. function TFTPComponent.Disconnect : Boolean;
  963. var TheReturnString : string;  { Internal string holder }
  964.     TheResult       : Integer; { Internal int holder    }
  965. begin
  966.   TheReturnString :=
  967.    DoCStyleFormat( 'QUIT' ,
  968.     [ nil ] );
  969.   { Put result in progress and status line }
  970.   AddProgressText( TheReturnString );
  971.   ShowProgressText( TheReturnString );
  972.   { Begin login sequence with user name }
  973.   TheResult := PerformFTPCommand( 'QUIT',
  974.                                   [ nil ] );
  975.   repeat
  976.     TheResult := GetFTPServerResponse( TheReturnString );
  977.     { Put result in progress and status line }
  978.     AddProgressText( TheReturnString );
  979.     ShowProgressText( TheReturnString );
  980.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  981.   FTPCommandInProgress := false;
  982.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  983.   begin
  984.     { Do clever C formatting trick }
  985.     TheReturnString :=
  986.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  987.       [ nil ] );
  988.     { Put result in progress and status line }
  989.     AddProgressText( TheReturnString );
  990.     ShowProgressErrorText( TheReturnString );
  991.     { Signal error }
  992.     Result := False;
  993.     { leave }
  994.     exit;
  995.   end
  996.   else Result := true; { Signal no problem }
  997. end;
  998.  
  999. { This is the FTP components PWD routine }
  1000. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : string )
  1001.           : Boolean;
  1002. var TheReturnString : string;  { Internal string holder }
  1003.     TheResult       : Integer; { Internal int holder    }
  1004. begin
  1005.   Result := true;
  1006.   TheReturnString :=
  1007.    DoCStyleFormat( 'PWD' ,
  1008.     [ nil ] );
  1009.   { Put result in progress and status line }
  1010.   AddProgressText( TheReturnString );
  1011.   ShowProgressText( TheReturnString );
  1012.   { Send Password sequence }
  1013.   TheResult := PerformFTPCommand( 'PWD',
  1014.                                   [ nil ] );
  1015.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1016.   begin
  1017.     Result := false;
  1018.     FTPCommandInProgress := false;
  1019.     exit;
  1020.   end;
  1021.   repeat
  1022.     TheResult := GetFTPServerResponse( TheReturnString );
  1023.     { Put result in progress and status line }
  1024.     AddProgressText( TheReturnString );
  1025.     ShowProgressText( TheReturnString );
  1026.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1027.   FTPCommandInProgress := false;
  1028.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1029.   begin
  1030.     { Do clever C formatting trick }
  1031.     TheReturnString :=
  1032.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1033.       [ nil ] );
  1034.     { Put result in progress and status line }
  1035.     AddProgressText( TheReturnString );
  1036.     ShowProgressErrorText( TheReturnString );
  1037.     { Signal error }
  1038.     Result := False;
  1039.     { leave }
  1040.     exit;
  1041.   end
  1042.   else
  1043.   begin
  1044.     Result := true; { Signal no problem }
  1045.     RemoteDir := TheReturnString; { Send back last string on faith }
  1046.   end;
  1047. end;
  1048.  
  1049. { This function sets up a listening port on socekt 2 and handle text replies }
  1050. function TFTPComponent.GetListeningPort : Integer;
  1051. var
  1052.   Address1 ,
  1053.   Address2 ,
  1054.   Address3 ,
  1055.   Address4        : Integer; { Address Integer conversions }
  1056.   IPAddress       : string;  { IP Address holder           }
  1057.   PortCommand     : string;  { Command holder              }
  1058.   TheResult       : Integer; { Result holder               }
  1059.   TheReturnString : string;  { ditto                       }
  1060. begin
  1061.   { Set up any port on socket 2 }
  1062.   Socket2.PortName := '0';
  1063.   { Listen on a socket }
  1064.   Socket2.CCSockListen;
  1065.   { Get the IP Address of socket 1 and convert it to numbers }
  1066.   IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  1067.   Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1068.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1069.   Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  1070.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1071.   Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1072.   Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  1073.   { Turn it into a command and add socket 2 stuff }
  1074.   PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
  1075.    [ Address1 , Address2 , Address3 , Address4 ,
  1076.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
  1077.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  1078.   { Put result in progress and status line }
  1079.   AddProgressText( PortCommand + #13#10 );
  1080.   ShowProgressText( PortCommand  + #13#10 );
  1081.   TheResult := PerformFTPCommand( PortCommand , [nil] );
  1082.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1083.   begin
  1084.     Result := FTP_STATUS_FATAL_ERROR;
  1085.     FTPCommandInProgress := false;
  1086.     exit;
  1087.   end;
  1088.   repeat
  1089.     TheResult := GetFTPServerResponse( TheReturnString );
  1090.     { Put result in progress and status line }
  1091.     AddProgressText( TheReturnString );
  1092.     ShowProgressText( TheReturnString );
  1093.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1094.   FTPCommandInProgress := false;
  1095.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1096.   begin
  1097.     { Do clever C formatting trick }
  1098.     TheReturnString :=
  1099.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1100.       [ nil ] );
  1101.     { Put result in progress and status line }
  1102.     AddProgressText( TheReturnString );
  1103.     ShowProgressErrorText( TheReturnString );
  1104.     { Signal error }
  1105.     Result := TheResult;
  1106.     { leave }
  1107.     exit;
  1108.   end
  1109.   else
  1110.   begin
  1111.     { Return good result and leave }
  1112.     Result := TheResult;
  1113.     exit;
  1114.   end;
  1115. end;
  1116.  
  1117. { This function returns part of a unit text string }
  1118. function TFTPComponent.GetUNIXTextString( var StringIn : string ) : string;
  1119. var
  1120.   ReturnString : string;
  1121.   TheLength ,
  1122.   Counter_1   : Integer;
  1123. begin
  1124.   TheLength := Length( StringIn );
  1125.   if TheLength > 1 then
  1126.   begin
  1127.     for Counter_1 := 1 to TheLength do
  1128.     begin
  1129.       if StringIn[ Counter_1 ] = #10 then
  1130.       begin
  1131.         ReturnString := HolderLine;
  1132.         HolderLine := '';
  1133.         StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
  1134.         Result := ReturnString;
  1135.         exit;
  1136.       end
  1137.       else
  1138.       begin
  1139.         if StringIn[ Counter_1 ] <> #0 then
  1140.         begin
  1141.           if StringIn[ Counter_1 ] <> #13 then
  1142.            HolderLine := HolderLine + StringIn[ Counter_1 ];
  1143.         end
  1144.         else
  1145.         begin
  1146.           Result := '';
  1147.           StringIn := '';
  1148.         end;
  1149.       end;
  1150.     end;
  1151.   end;
  1152.   Result := '';
  1153.   StringIn := '';
  1154. end;
  1155.  
  1156. procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : string );
  1157. var Counter_1 : Integer;
  1158.     ResultString : string;
  1159.     Finished : Boolean;
  1160. begin
  1161.   if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  1162.   begin
  1163.     TheName := '';
  1164.     exit;
  1165.   end;
  1166.   Counter_1 := Length( TheName );
  1167.   ResultString := '';
  1168.   Finished := false;
  1169.   while not Finished do
  1170.   begin
  1171.     if TheName[ Counter_1 ] <> ' ' then
  1172.     begin
  1173.       Counter_1 := Counter_1 - 1;
  1174.       if Counter_1 = 0 then
  1175.       begin
  1176.         ResultString := TheName;
  1177.         Finished := true;
  1178.       end;
  1179.     end
  1180.     else
  1181.     begin
  1182.       Finished := true;
  1183.       ResultString := Copy( TheName , Counter_1 + 1 , 255 );
  1184.     end;
  1185.   end;
  1186.   TheName := ResultString;
  1187. end;
  1188.  
  1189. { This is the FTP components get remote directory listing into a list box }
  1190. function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
  1191.           : Boolean;
  1192. var TheReturnString : string;  { Internal string holder }
  1193.     TheResult       : Integer; { Internal int holder    }
  1194.     InputString     : string;
  1195.     Through ,
  1196.     Finished        : Boolean;
  1197. begin
  1198.   TheListBox.Clear;
  1199.   TheListBox.Items.Add('..');
  1200.   Result := true;
  1201.   TheReturnString :=
  1202.    DoCStyleFormat( 'TYPE A' ,
  1203.     [ nil ] );
  1204.   { Put result in progress and status line }
  1205.   AddProgressText( TheReturnString );
  1206.   ShowProgressText( TheReturnString );
  1207.   { Send Password sequence }
  1208.   TheResult := PerformFTPCommand( 'TYPE A',
  1209.                                   [ nil ] );
  1210.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1211.   begin
  1212.     Result := true;
  1213.     FTPCommandInProgress := false;
  1214.     exit;
  1215.   end;
  1216.   repeat
  1217.     TheResult := GetFTPServerResponse( TheReturnString );
  1218.     { Put result in progress and status line }
  1219.     AddProgressText( TheReturnString );
  1220.     ShowProgressText( TheReturnString );
  1221.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1222.   FTPCommandInProgress := false;
  1223.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1224.   begin
  1225.     { Do clever C formatting trick }
  1226.     TheReturnString :=
  1227.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1228.       [ nil ] );
  1229.     { Put result in progress and status line }
  1230.     AddProgressText( TheReturnString );
  1231.     ShowProgressErrorText( TheReturnString );
  1232.     { Signal error }
  1233.     Result := true;
  1234.     { leave }
  1235.     exit;
  1236.   end
  1237.   else
  1238.   begin
  1239.     { Set up socket 2 for listening }
  1240.     Socket2.AsynchMode := False;
  1241.     Socket2.NonAsynchTimeoutValue := 60;
  1242.     { do a listen and send command to server that this is receipt socket }
  1243.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  1244.     begin
  1245.       Socket2.CCSockCancelListen;
  1246.       exit;
  1247.     end;
  1248.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1249.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  1250.     GetFTPServerResponse( TheReturnString );
  1251.     AddProgressText( TheReturnString );
  1252.     ShowProgressText( TheReturnString );
  1253.     Socket1.NonAsynchTimeoutValue := 30;
  1254.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  1255.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  1256.     begin
  1257.       TheReturnString :=
  1258.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  1259.         [ nil ] );
  1260.       { Put result in progress and status line }
  1261.       AddProgressText( TheReturnString );
  1262.       ShowProgressErrorText( TheReturnString );
  1263.       Socket2.CCSockCancelListen;
  1264.       Result := true;
  1265.       exit;
  1266.     end;
  1267.     Socket2.CCSockAccept;
  1268.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1269.     begin
  1270.       TheReturnString :=
  1271.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1272.         [ nil ] );
  1273.       { Put result in progress and status line }
  1274.       AddProgressText( TheReturnString );
  1275.       ShowProgressErrorText( TheReturnString );
  1276.       Result := true;
  1277.       exit;
  1278.     end;
  1279.     Through := false;
  1280.     repeat
  1281.       TheReturnString := Socket2.StringData;
  1282.       if Length( TheReturnString ) = 0 then Through := true;
  1283.       if Length( TheReturnString ) > 0 then
  1284.       begin
  1285.         finished := false;
  1286.         while not finished do
  1287.         begin
  1288.           InputString := GetUNIXTextString( TheReturnString );
  1289.           if InputString = '' then Finished := true else
  1290.           begin
  1291.             GetFileNameFromUNIXFileName( InputString);
  1292.             If InputString <> '' then
  1293.             TheListBox.Items.Add( InputString );
  1294.           end;
  1295.         end;
  1296.       end;
  1297.       if GlobalAbortedFlag then
  1298.       begin
  1299.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1300.         repeat
  1301.           TheResult := GetFTPServerResponse( TheReturnString );
  1302.           { Put result in progress and status line }
  1303.           AddProgressText( TheReturnString );
  1304.           ShowProgressText( TheReturnString );
  1305.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1306.         result := true;
  1307.         exit;
  1308.       end;
  1309.     until Through;
  1310.     GetFTPServerResponse( TheReturnString );
  1311.     AddProgressText( TheReturnString );
  1312.     ShowProgressText( TheReturnString );
  1313.     { cancel listening on second socket and close it }
  1314.     Socket2.CCSockCancelListen;
  1315.     Socket2.CCSockClose;
  1316.   end;
  1317.   FTPCommandInProgress := false;
  1318. end;
  1319.  
  1320. { This is the FTP components get remote directory listing into a list box }
  1321. function TFTPComponent.GetRemoteDirectoryListingToMemo : Boolean;
  1322. var TheReturnString : string;  { Internal string holder }
  1323.     TheResult       : Integer; { Internal int holder    }
  1324.     InputString     : string;
  1325.     Through ,
  1326.     Finished        : Boolean;
  1327. begin
  1328.   Result := true;
  1329.   TheReturnString :=
  1330.    DoCStyleFormat( 'TYPE A' ,
  1331.     [ nil ] );
  1332.   { Put result in progress and status line }
  1333.   AddProgressText( TheReturnString );
  1334.   ShowProgressText( TheReturnString );
  1335.   { Send Password sequence }
  1336.   TheResult := PerformFTPCommand( 'TYPE A',
  1337.                                   [ nil ] );
  1338.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1339.   begin
  1340.     Result := true;
  1341.     FTPCommandInProgress := false;
  1342.     exit;
  1343.   end;
  1344.   repeat
  1345.     TheResult := GetFTPServerResponse( TheReturnString );
  1346.     { Put result in progress and status line }
  1347.     AddProgressText( TheReturnString );
  1348.     ShowProgressText( TheReturnString );
  1349.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1350.   FTPCommandInProgress := false;
  1351.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1352.   begin
  1353.     { Do clever C formatting trick }
  1354.     TheReturnString :=
  1355.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1356.       [ nil ] );
  1357.     { Put result in progress and status line }
  1358.     AddProgressText( TheReturnString );
  1359.     ShowProgressErrorText( TheReturnString );
  1360.     { Signal error }
  1361.     Result := true;
  1362.     { leave }
  1363.     exit;
  1364.   end
  1365.   else
  1366.   begin
  1367.     { Set up socket 2 for listening }
  1368.     Socket2.AsynchMode := False;
  1369.     Socket2.NonAsynchTimeoutValue := 30;
  1370.     { do a listen and send command to server that this is receipt socket }
  1371.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  1372.     begin
  1373.       Socket2.CCSockCancelListen;
  1374.       exit;
  1375.     end;
  1376.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1377.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  1378.     GetFTPServerResponse( TheReturnString );
  1379.     AddProgressText( TheReturnString );
  1380.     ShowProgressText( TheReturnString );
  1381.     Socket1.NonAsynchTimeoutValue := 30;
  1382.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  1383.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  1384.     begin
  1385.       TheReturnString :=
  1386.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  1387.         [ nil ] );
  1388.       { Put result in progress and status line }
  1389.       AddProgressText( TheReturnString );
  1390.       ShowProgressErrorText( TheReturnString );
  1391.       Socket2.CCSockCancelListen;
  1392.       Result := true;
  1393.       exit;
  1394.     end;
  1395.     Socket2.CCSockAccept;
  1396.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1397.     begin
  1398.       TheReturnString :=
  1399.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1400.         [ nil ] );
  1401.       { Put result in progress and status line }
  1402.       AddProgressText( TheReturnString );
  1403.       ShowProgressErrorText( TheReturnString );
  1404.       Result := true;
  1405.       exit;
  1406.     end;
  1407.     Through := false;
  1408.     repeat
  1409.       TheReturnString := Socket2.StringData;
  1410.       if Length( TheReturnString ) = 0 then Through := true;
  1411.       if Length( TheReturnString ) > 0 then
  1412.       begin
  1413.         { Put result in progress and status line }
  1414.         AddProgressText( TheReturnString );
  1415.         ShowProgressText( TheReturnString );
  1416.       end;
  1417.       if GlobalAbortedFlag then
  1418.       begin
  1419.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1420.         repeat
  1421.           TheResult := GetFTPServerResponse( TheReturnString );
  1422.           { Put result in progress and status line }
  1423.           AddProgressText( TheReturnString );
  1424.           ShowProgressText( TheReturnString );
  1425.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1426.         result := true;
  1427.         exit;
  1428.       end;
  1429.     until Through;
  1430.     GetFTPServerResponse( TheReturnString );
  1431.     AddProgressText( TheReturnString );
  1432.     ShowProgressText( TheReturnString );
  1433.     { cancel listening on second socket and close it }
  1434.     Socket2.CCSockCancelListen;
  1435.     Socket2.CCSockClose;
  1436.   end;
  1437. end;
  1438.  
  1439. { This is the FTP components get local directory listing into a list box }
  1440. function TFTPComponent.GetLocalDirectoryAndListing( var TheString : string;
  1441.                                                         TheListBox : TListBox )
  1442.           : Boolean;
  1443. var TheFLB : TFileListBox;
  1444. begin
  1445.   { Get the working directory }
  1446.   GetDir( 0 , TheString );
  1447.   { Clear incoming LB }
  1448.   TheListBox.Clear;
  1449.   TheFLB := TFileListBox.Create( Application.MainForm );
  1450.   TheFLB.Visible := false;
  1451.   TheFLB.Parent := Application.MainForm;
  1452.   TheFLB.FileType := [ ftNormal , ftDirectory ];
  1453.   TheFLB.Directory := TheString;
  1454.   TheFLB.Update;
  1455.   TheListBox.Items.Assign( TheFLB.Items );
  1456.   TheFLB.Free;
  1457.   result := true;
  1458. end;
  1459.  
  1460. { This is a clever c-style formatting trick }
  1461. function TFTPComponent.DoCStyleFormat(
  1462.                 TheText      : string;
  1463.           const TheArguments : array of const ) : string;
  1464. begin
  1465.   Result := Format( TheText , TheArguments ) + #13#10;
  1466. end;
  1467.  
  1468. function TFTPComponent.GetQuotedString( TheString : string ) : string;
  1469. var TheIndex     : Integer; { Holder var }
  1470.     ResultString : string;  { ditto      }
  1471. begin
  1472.   { Find out if " present at all }
  1473.   TheIndex := Pos( '"' , TheString );
  1474.   If TheIndex = 0 then
  1475.   begin
  1476.     { If not, return null string and exit }
  1477.     Result := '';
  1478.     exit;
  1479.   end
  1480.   else
  1481.   begin
  1482.     { Get from first " to end of string in holder }
  1483.     ResultString := Copy( TheString , TheIndex + 1 , 255 );
  1484.     { Find position to second " }
  1485.     TheIndex := Pos( '"' , ResultString );
  1486.     { If no ending " then return whole string and leave }
  1487.     if TheIndex = 0 then
  1488.     begin
  1489.       Result := ResultString;
  1490.       exit;
  1491.     end
  1492.     else
  1493.     begin
  1494.       { Get internal text between quotes and exit }
  1495.       ResultString := Copy( ResultString , 1 , TheIndex - 1 );
  1496.       Result := ResultString;
  1497.     end;
  1498.   end;
  1499. end;
  1500.  
  1501. procedure TCCINetCCForm.UpdateGauge( BytesFinished , TotalToHandle : longint );
  1502. var
  1503.   Percentage : longint;
  1504. begin
  1505.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  1506.   if TotalToHandle = 0 then exit;
  1507.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  1508.   Gauge1.Progress := Percentage;
  1509.   Panel1.Caption := '  Status: Transfered ' + IntToStr( BytesFinished ) +
  1510.    ' bytes of file ' + FileNameToXFer + ' (' + IntToStr( Percentage ) + '% Complete)';
  1511. end;
  1512.  
  1513. { This procedure actually attempts to connect to the internet at an ftp site }
  1514. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  1515. var TheReturnString : string; { Display results of connection in status lines }
  1516.     TheResult       : Integer;{ Result from FTP server                        }
  1517.     FTPLoggedIn     : Boolean;{ Boolean to signal successful login            }
  1518. begin
  1519.   { Create the component }
  1520.   Result := false;
  1521.   { Do busy cursors }
  1522.   SetHGCursors;
  1523.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  1524.   begin
  1525.     { Do saved cursors }
  1526.     TheFTPComponent.FTPCommandInProgress := false;
  1527.     TheFTPComponent.Connection_Established := false;
  1528.     SetNormalCursors;
  1529.     exit;
  1530.   end
  1531.   else
  1532.   begin { Connected; continue login process }
  1533.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  1534.     begin
  1535.       { Do saved cursors }
  1536.       TheFTPComponent.FTPCommandInProgress := false;
  1537.       TheFTPComponent.Connection_Established := false;
  1538.       SetNormalCursors;
  1539.       exit;
  1540.     end;
  1541.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  1542.     begin
  1543.       { Do saved cursors }
  1544.       TheFTPComponent.FTPCommandInProgress := false;
  1545.       TheFTPComponent.Connection_Established := false;
  1546.       SetNormalCursors;
  1547.       exit;
  1548.     end;
  1549.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  1550.     begin
  1551.       { Do saved cursors }
  1552.       SetNormalCursors;
  1553.       TheFTPComponent.Connection_Established := false;
  1554.       TheFTPComponent.FTPCommandInProgress := false;
  1555.       exit;
  1556.     end;
  1557.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  1558.     begin
  1559.       { Do saved cursors }
  1560.       TheFTPComponent.Connection_Established := false;
  1561.       TheFTPComponent.FTPCommandInProgress := false;
  1562.       SetNormalCursors;
  1563.       exit;
  1564.     end;
  1565.     { Put up remote directory via PWD and strip quotes }
  1566.     Label4.Caption := TheFTPComponent.GetQuotedString( TheReturnString );
  1567.     { Get the listings of directories and exit OK }
  1568.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  1569.     TheFTPComponent.GetLocalDirectoryAndListing( TheReturnString ,
  1570.      Listbox2 );
  1571.     if Label5.Canvas.TextWidth( TheReturnString ) > Label5.Width then
  1572.      TheReturnString := TheFTPComponent.GetShortPathName( TheReturnString );
  1573.     Label5.Caption := TheReturnString;
  1574.     SetNormalCursors;
  1575.     Result := true;
  1576.     EnableFTPMenus;
  1577.     TheFTPComponent.FTPCommandInProgress := false;
  1578.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  1579.   end;
  1580. end;
  1581.  
  1582. { This procedure actually attempts to disconnect to the internet at an ftp site}
  1583. procedure TCCINetCCForm.DoFTPDisconnect;
  1584. begin
  1585.   { Call QUIT command }
  1586.   TheFTPComponent.Disconnect;
  1587.   { Kill the socket }
  1588.   TheFTPComponent.Socket1.CCSockClose;
  1589. end;
  1590.  
  1591. { This procedure reads in the ini file and default path info }
  1592. procedure TCCINetCCForm.ReadIniData;
  1593. begin
  1594.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  1595.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  1596.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  1597.   WWWPath := TheICCIniFile.ReadString( 'Paths','WWWPath','C:\WINDOWS' );
  1598.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  1599.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  1600.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  1601.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  1602.   TheICCIniFile.Free;
  1603. end;
  1604.  
  1605. { This procedure writes out default path data to the ini file }
  1606. procedure TCCINetCCForm.WriteIniData;
  1607. begin
  1608.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  1609.   TheICCIniFile.WriteString( 'Paths','MailPath',MailPath );
  1610.   TheICCIniFile.WriteString( 'Paths','NewsPath',NewsPath );
  1611.   TheICCIniFile.WriteString( 'Paths','WWWPath',WWWPath );
  1612.   TheICCIniFile.WriteString( 'Paths','FTPPath',FTPPath );
  1613.   TheICCIniFile.WriteInteger( 'Vectors','PWControl',PasswordControlVector );
  1614.   TheICCIniFile.WriteInteger( 'Vectors','DefDL',DefaultDownloadVector );
  1615.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  1616.   TheICCIniFile.Free;
  1617. end;
  1618.  
  1619. { Procedure to load the FTP Site list }
  1620. procedure TCCINetCCForm.LoadFTPSiteFile;
  1621. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  1622.     FTPSLName   : string;             { FTP Site List filename }
  1623.     Counter_1   : Integer;            { Loop counter           }
  1624. begin
  1625.   { Create the sites list list }
  1626.   TheFTPSiteList := TList.Create;
  1627.   { Set up the FTP sites list file name }
  1628.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  1629.   { If the FTP Site List exists load it in }
  1630.   if FileExists( FTPSLName ) then
  1631.   begin
  1632.     { set up the file and open it }
  1633.     AssignFile( TheFTPSiteFile , FTPSLName );
  1634.     Reset( TheFTPSiteFile );
  1635.     { read in the records }
  1636.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  1637.     begin
  1638.       { Create the TCRecord }
  1639.       New( TheTCRecord );
  1640.       { Read in the data record }
  1641.       Seek( TheFTPSiteFile , Counter_1 );
  1642.       Read( TheFTPSiteFile , TheTCRecord^ );
  1643.       { Add the record to the list }
  1644.       TheFTPSiteList.Add( TheTCRecord );
  1645.     end;
  1646.     { close the file }
  1647.     CloseFile( TheFTPSiteFile );
  1648.   end
  1649.   else
  1650.   { Otherwise create a default one with a few anonymous sites }
  1651.   begin
  1652.     { create new record }
  1653.     New( TheTCRecord );
  1654.     { fill in its info }
  1655.     with TheTCRecord^ do
  1656.     begin
  1657.       CProfile   := 'Winsite Windows Archive';
  1658.       CIPAddress := 'ftp.winsite.com';
  1659.       CUserName  := 'anonymous';
  1660.       CPassword  := 'guest@nowhere.com';
  1661.       CStartDir  := '';
  1662.     end;
  1663.     { add it to the list }
  1664.     { do it three more times }
  1665.     TheFTPSiteList.Add( TheTCRecord );
  1666.     New( TheTCRecord );
  1667.     with TheTCRecord^ do
  1668.     begin
  1669.       CProfile   := 'Digital Equipment Corp';
  1670.       CIPAddress := 'gatekeeper.dec.com';
  1671.       CUserName  := 'anonymous';
  1672.       CPassword  := 'guest@nowhere.com';
  1673.       CStartDir  := '';
  1674.     end;
  1675.     TheFTPSiteList.Add( TheTCRecord );
  1676.     New( TheTCRecord );
  1677.     with TheTCRecord^ do
  1678.     begin
  1679.       CProfile   := 'Microsoft FTP Site';
  1680.       CIPAddress := 'ftp.microsoft.com';
  1681.       CUserName  := 'anonymous';
  1682.       CPassword  := 'guest@nowhere.com';
  1683.       CStartDir  := '';
  1684.     end;
  1685.     TheFTPSiteList.Add( TheTCRecord );
  1686.     New( TheTCRecord );
  1687.     with TheTCRecord^ do
  1688.     begin
  1689.       CProfile   := 'Oakland MSDOS Archive';
  1690.       CIPAddress := 'oak.oakland.edu';
  1691.       CUserName  := 'anonymous';
  1692.       CPassword  := 'guest@nowhere.com';
  1693.       CStartDir  := '';
  1694.     end;
  1695.     TheFTPSiteList.Add( TheTCRecord );
  1696.     { create the file and write out the data, then close it }
  1697.     AssignFile( TheFTPSiteFile , FTPSLName );
  1698.     Rewrite( TheFTPSiteFile );
  1699.     for Counter_1 := 0 to 3 do
  1700.     begin
  1701.       TheTCRecord :=
  1702.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  1703.       Seek( TheFTPSiteFile , Counter_1 );
  1704.       Write( TheFTPSiteFile , TheTCRecord^ );
  1705.     end;
  1706.     CloseFile( TheFTPSiteFile );
  1707.   end;
  1708. end;
  1709.  
  1710. { This procedure saves off the FTP Site List }
  1711. procedure TCCINetCCForm.SaveFTPSiteFile;
  1712. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  1713.     FTPSLName   : string;             { FTP Site List filename }
  1714.     Counter_1   : Integer;            { Loop counter           }
  1715. begin
  1716.   { Set up the file name }
  1717.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  1718.   { Assign the file }
  1719.   AssignFile( TheFTPSiteFile , FTPSLName );
  1720.   { Rewrite it }
  1721.   Rewrite( TheFTPSiteFile );
  1722.   { run the list through the procedure }
  1723.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1724.   begin
  1725.     { get the record from the list }
  1726.     TheTCRecord :=
  1727.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  1728.     { Do the seek/write }
  1729.     Seek( TheFTPSiteFile , Counter_1 );
  1730.     Write( TheFTPSiteFile , TheTCRecord^ );
  1731.     { free the record }
  1732.     Dispose( TheTCRecord );
  1733.   end;
  1734.   { Close the file }
  1735.   CloseFile( TheFTPSiteFile );
  1736.   { Free the list pointers }
  1737.   TheFTPSiteList.Free;
  1738.   TheWorkingFTPSL.Free;
  1739. end;
  1740.  
  1741. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  1742. procedure TCCINetCCForm.SetupFTPSiteLists;
  1743. var ThePointer : PConnectionsRecord; { Generic PCR Pointer }
  1744.     Counter_1  : Integer;            { Loop counter        } 
  1745. begin
  1746.   { Set up display for main form }
  1747.   CCINetCCForm.Tag := 2;
  1748.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  1749.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  1750.   CCINetCCForm.FTP1.Enabled := false;
  1751.   CCINetCCForm.FTP2.Enabled := true;
  1752.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  1753.   CCINetCCForm.Button1.Caption := 'Connect';
  1754.   CCINetCCForm.Label4.Caption := 'Local Dir';
  1755.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  1756.   { Set tag for FTP stuff }
  1757.   CCICInfoDlg.Tag := 2;
  1758.   { set up caption of main label }
  1759.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  1760.   { hide outline panel }
  1761.   CCICInfoDlg.Panel6.Visible := false;
  1762.   { clear the list box }
  1763.   CCICInfoDlg.ListBox2.Clear;
  1764.   CCINetCCForm.ComboBox1.Clear;
  1765.   { add profile strings to the list box }
  1766.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1767.   begin
  1768.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  1769.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  1770.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  1771.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  1772.   end;
  1773.   { Set up caption of special button }
  1774.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  1775.   { Start with top record }
  1776.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  1777.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  1778.   { put in data from top record and reset captions }
  1779.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  1780.   begin
  1781.     with CCICInfoDlg do
  1782.     begin
  1783.       Edit1.Text := CProfile;
  1784.       Panel2.Caption := '            Name:';
  1785.       Edit2.Text := CIPAddress;
  1786.       Panel3.Caption := '     IP Address:';
  1787.       Edit3.Text := CUserName;
  1788.       Panel5.Caption := '    User Name:';
  1789.       case PasswordControlVector of
  1790.         1 : Edit4.Text := CPassword;
  1791.         2 : Edit4.Text := '**********';
  1792.       end;
  1793.       Panel8.Caption := '      Password:';
  1794.       Edit5.Text := CStartDir;
  1795.       Panel9.Caption := '    Starting Dir:';
  1796.     end;
  1797.   end;
  1798.   { Create the working copy for use to make safe changes in info dlg }
  1799.   TheWorkingFTPSL := TList.Create;
  1800.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1801.   begin
  1802.     New( ThePointer );
  1803.     ThePointer^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  1804.     TheWorkingFTPSL.Add( ThePointer );
  1805.   end;
  1806. end;
  1807.  
  1808. { This procedure scans a line of UNIX-style text for #10's and }
  1809. { outputs them as lines to the memo. It stops at #0.           }
  1810. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : string;
  1811.                                  TheMemoToAddTo : TMemo   );
  1812. var
  1813.   TextLength ,            { Total chars to output         }
  1814.   Counter_1    : Integer; { Loop Index                    }
  1815. begin
  1816.   { Make the target memo visible just in case }
  1817.   TheMemoToAddTo.Visible := true;
  1818.   { Find total chars to output }
  1819.   TextLength := Length( TheTextToAdd );
  1820.   { If none then leave }
  1821.   if TextLength = 0 then exit;
  1822.   { Loop along the string }
  1823.   for Counter_1 := 1 to TextLength do
  1824.   begin
  1825.     { If hit ASCII 10 then assume end of line and output }
  1826.     if TheTextToAdd[ Counter_1 ] = #10 then
  1827.     begin
  1828.       { Use a try loop incase memo fills up }
  1829.       try
  1830.         { Add the line }
  1831.         TheMemoToAddTo.Lines.Add( TheLine );
  1832.       except
  1833.         { If memo fills up }
  1834.         on EOutOfResources do
  1835.         begin
  1836.           { Clear the old data }
  1837.           TheMemoToAddTo.Clear;
  1838.           { Output the new }
  1839.           TheMemoToAddTo.Lines.Add( TheLine );
  1840.         end;
  1841.       end;
  1842.       { clear the output buffer }
  1843.       TheLine := '';
  1844.     end
  1845.     else
  1846.     { Otherwise look for null terminator from Winsock }
  1847.     begin
  1848.       { If don't hit null terminator then add the char to op buffer }
  1849.       if TheTextToAdd[ Counter_1 ] <> #0 then
  1850.       begin
  1851.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  1852.       end
  1853.       else
  1854.       begin
  1855.         if TheLine <> '' then
  1856.         begin
  1857.           { Use a try loop incase memo fills up }
  1858.           try
  1859.             { Add the line }
  1860.             TheMemoToAddTo.Lines.Add( TheLine );
  1861.           except
  1862.             { If memo fills up }
  1863.             on EOutOfResources do
  1864.             begin
  1865.               { Clear the old data }
  1866.               TheMemoToAddTo.Clear;
  1867.               { Output the new }
  1868.               TheMemoToAddTo.Lines.Add( TheLine );
  1869.             end;
  1870.           end;
  1871.           { clear the output buffer }
  1872.           TheLine := '';
  1873.         end;
  1874.       end;
  1875.     end;
  1876.   end;
  1877. end;
  1878.  
  1879. { This function scans a line of UNIX-style text for #10's and }
  1880. { outputs the first line as its return value,stopping at #0.  }
  1881. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
  1882. var
  1883.   TheLine      : string;  { Buffer to output current line }
  1884.   TextLength ,            { Total chars to output         }
  1885.   Counter_1    : Integer; { Loop Index                    }
  1886. begin
  1887.   { Clear output buffer }
  1888.   TheLine := '';
  1889.   { Find total chars to output }
  1890.   TextLength := Length( TheTextToAdd );
  1891.   { If none then leave }
  1892.   if TextLength = 0 then
  1893.   begin
  1894.     { Return nothing }
  1895.     Result := '';
  1896.     { Leave }
  1897.     exit;
  1898.   end;
  1899.   { Loop along the string }
  1900.   for Counter_1 := 1 to TextLength do
  1901.   begin
  1902.     { If hit ASCII 10 then assume end of line and output }
  1903.     if TheTextToAdd[ Counter_1 ] = #10 then
  1904.     begin
  1905.       { Return first line }
  1906.       Result := TheLine;
  1907.       { Leave }
  1908.       exit;
  1909.     end
  1910.     else
  1911.     { Otherwise look for null terminator from Winsock }
  1912.     begin
  1913.       { If don't hit null terminator then add the char to op buffer }
  1914.       if TheTextToAdd[ Counter_1 ] <> #0 then
  1915.       begin
  1916.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  1917.       end
  1918.       else break; { Otherwise drop out of the loop }
  1919.     end;
  1920.   end;
  1921.   { If hit #0 before #10 return buffer }
  1922.   Result := TheLine;
  1923. end;
  1924.  
  1925. { Show busy cursors }
  1926. procedure TCCINetCCForm.SetHGCursors;
  1927. begin
  1928.   CCInetCCForm.Cursor := crHourGlass;
  1929.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  1930. end;
  1931.  
  1932. { Show normal cursors }
  1933. procedure TCCINetCCForm.SetNormalCursors;
  1934. begin
  1935.   CCInetCCForm.Cursor := crDefault;
  1936.   CCInetCCForm.Memo1.Cursor := crDefault;
  1937. end;
  1938.  
  1939. { Exit method }
  1940. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  1941. begin
  1942.   Close;
  1943. end;
  1944.  
  1945. { This method adds a line to the progress text stringlist  }
  1946. { If an exception occurs, the list is full, and it is auto }
  1947. { saved to the progress text file name, then cleared.      }
  1948. procedure TCCINetCCForm.AddProgressText( WhatText : string );
  1949. begin
  1950.   { Use a try..except loop to catch list overflows }
  1951.   try
  1952.     { Try the normal add }
  1953.     ProgressList.Add( WhatText );
  1954.   except
  1955.     { Any list error is assumed to be a list overflow }
  1956.     on EListError do
  1957.     begin
  1958.       { Save the list to the preset file name }
  1959.       ProgressList.SaveToFile( ProgressFileName );
  1960.       { Clear the list to make more room }
  1961.       ProgressList.Clear;
  1962.       { And redo the add; any further errors will except normally }
  1963.       ProgressList.Add( WhatText );
  1964.     end;
  1965.     { This might happen too! }
  1966.     on EOutOfResources do
  1967.     begin
  1968.       { Save the list to the preset file name }
  1969.       ProgressList.SaveToFile( ProgressFileName );
  1970.       { Clear the list to make more room }
  1971.       ProgressList.Clear;
  1972.       { And redo the add; any further errors will except normally }
  1973.       ProgressList.Add( WhatText );
  1974.     end;
  1975.   end;
  1976. end;
  1977.  
  1978. { This method either adds the progress line to the current memo }
  1979. { or puts it in the status caption at normal colors.            }
  1980. procedure TCCINetCCForm.ShowProgressText( WhatText : string );
  1981. begin
  1982.   { Use the POV to determine where to show progress info }
  1983.   case ProgressOutputVector of
  1984.     POV_MEMO : begin { Output into the memo  }
  1985.                  AddNullTermTextToMemo( WhatText , Memo1 );
  1986.                end;
  1987.     POV_STAT : begin { Output on status line }
  1988.                  { Set panel caption font to black }
  1989.                  Panel1.Font.Color := clBlack;
  1990.                  { Get the first line of text and put in caption }
  1991.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  1992.                end;
  1993.   end;
  1994. end;
  1995.  
  1996. { This method is identical with SPT except sets status color to red and beeps }
  1997. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : string );
  1998. begin
  1999.   { Do error beep }
  2000.   MessageBeep( mb_IconExclamation );
  2001.   { Use the POV to determine where to show progress info }
  2002.   case ProgressOutputVector of
  2003.     POV_MEMO : begin { Output into the memo  }
  2004.                  AddNullTermTextToMemo( WhatText , Memo1 );
  2005.                end;
  2006.     POV_STAT : begin { Output on status line }
  2007.                  { Set panel caption font to black }
  2008.                  Panel1.Font.Color := clRed;
  2009.                  { Get the first line of text and put in caption }
  2010.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  2011.                end;
  2012.   end;
  2013. end;
  2014.  
  2015. { This is the boilerplate method used to handle Socket errors gracefully }
  2016. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  2017.                                               ErrorCode  : Integer;
  2018.                                               TheMessage : string   );
  2019. begin
  2020.   { Set the global error code flag }
  2021.   GlobalErrorCode := ErrorCode;
  2022.   { If a timeout error }
  2023.   if ErrorCode = WSAETIMEDOUT then
  2024.   begin
  2025.     { Set the aborted flag }
  2026.     GlobalAbortedFlag := True;
  2027.     { But clear the error code for graceful handling }
  2028.     GlobalErrorCode := 0;
  2029.   end
  2030.   else
  2031.   begin
  2032.     { Otherwise set the progress buffer to the error message }
  2033.     AddProgressText( TheMessage );
  2034.     { And show the progress text as set by option }
  2035.     ShowProgressErrorText( TheMessage );
  2036.   end;
  2037. end;
  2038.  
  2039. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  2040. begin
  2041.   { Create the progress string list }
  2042.   ProgressList := TStringList.Create;
  2043.   { Create the file name for saving the progress list }
  2044.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  2045.   { Default progress output to status line }
  2046.   ProgressOutputVector := POV_STAT;
  2047.   { Set password control stuff }
  2048.   PasswordControlVector := 2;
  2049.   CurrentPasswordString := 'guest@nowhere.com';
  2050.   CurrentRealPWString := 'guest@nowhere.com';
  2051.   { Get Ini file Data }
  2052.   ReadIniData;
  2053.   LoadFTPSiteFile;
  2054. end;
  2055.  
  2056. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  2057. begin
  2058.   { Free the progress text stringlist if assigned }
  2059.   if assigned( ProgressList ) then ProgressList.Free;
  2060.   { Save off the Ini data }
  2061.   WriteIniData;
  2062.   { Save and remove FTP site list stuff }
  2063.   SaveFTPSiteFile;
  2064.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  2065. end;
  2066.  
  2067. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  2068. var
  2069.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  2070.   TheData    : string;    { Holder for data                           }
  2071. begin
  2072.   { Create socket; auto calls WSAStartup }
  2073.   TempSocket := TCCSocket.Create( Self );
  2074.   { Do parent just for kicks; no longer needed }
  2075.   TempSocket.Parent := self;
  2076.   { Put in error handler }
  2077.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  2078.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  2079.   { Display the Description string }
  2080.   AddProgressText( TheData + #0 );
  2081.   { And show the progress text as set by option }
  2082.   ShowProgressText( TheData + #0 );
  2083.   { Free the socket; auto calls WSACleanup }
  2084.   TempSocket.Free;
  2085. end;
  2086.  
  2087. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  2088. var
  2089.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  2090.   TheData    : string;    { Holder for data                           }
  2091. begin
  2092.   { Create socket; auto calls WSAStartup }
  2093.   TempSocket := TCCSocket.Create( Self );
  2094.   { Do parent just for kicks; no longer needed }
  2095.   TempSocket.Parent := self;
  2096.   { Put in error handler }
  2097.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  2098.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  2099.   { Display the Description string }
  2100.   AddProgressText( TheData + #0 );
  2101.   { And show the progress text as set by option }
  2102.   ShowProgressText( TheData + #0 );
  2103.   { Free the socket; auto calls WSACleanup }
  2104.   TempSocket.Free;
  2105. end;
  2106.  
  2107. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  2108. var
  2109.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  2110.   TheData    : string;    { Holder for data                           }
  2111. begin
  2112.   { Create socket; auto calls WSAStartup }
  2113.   TempSocket := TCCSocket.Create( Self );
  2114.   { Do parent just for kicks; no longer needed }
  2115.   TempSocket.Parent := self;
  2116.   { Put in error handler }
  2117.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  2118.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  2119.   { Display the Description string }
  2120.   AddProgressText( TheData + #0 );
  2121.   { And show the progress text as set by option }
  2122.   ShowProgressText( TheData + #0 );
  2123.   { Free the socket; auto calls WSACleanup }
  2124.   TempSocket.Free;
  2125. end;
  2126.  
  2127. { This method sets the progress output vector to the memo }
  2128. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  2129. begin
  2130.   { Set the vector }
  2131.   ProgressOutputVector := POV_MEMO;
  2132.   { Keep the menu options consistent }
  2133.   ViewInEditWindow1.Checked := true;
  2134.   ViewInStatusLine1.Checked := false;
  2135. end;
  2136.  
  2137. { This method sets the progress output vector to the status line }
  2138. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  2139. begin
  2140.   { Set the vector }
  2141.   ProgressOutputVector := POV_STAT;
  2142.   { Keep the menus consistent }
  2143.   ViewInEditWindow1.Checked := false;
  2144.   ViewInStatusLine1.Checked := true;
  2145. end;
  2146.  
  2147. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  2148. begin
  2149.   { Set up the dialog parameters }
  2150.   OpenDialog1.Filename := ProgressFileName;
  2151.   OpenDialog1.Title := 'Select Filename for Progress File';
  2152.   OpenDialog1.Filter := 'Text Files|*.txt';
  2153.   { If the dialog is not cancelled then save and clear }
  2154.   if OpenDialog1.Execute then
  2155.   begin
  2156.     ProgressFileName := OpenDialog1.FileName;
  2157.     ProgressList.SaveToFile( ProgressFileName );
  2158.     ProgressList.Clear;
  2159.   end;
  2160. end;
  2161.  
  2162. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  2163. begin
  2164.   { Set up info dialog for IP Address getting }
  2165.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  2166.   CCICInfoDlg.Panel4.Visible := false;
  2167.   CCICInfoDlg.Panel6.Visible := false;
  2168.   CCICInfoDlg.Panel9.Visible := false;
  2169.   CCICInfoDlg.Panel8.Visible := false;
  2170.   CCICInfoDlg.BitBtn2.Visible := false;
  2171.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  2172.   CCICInfoDlg.Button2.Visible := false;
  2173.   CCICInfoDlg.Button3.Visible := false;
  2174.   CCICInfoDlg.Button4.Visible := false;
  2175.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  2176.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  2177.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  2178.   CCICInfoDlg.Edit1.Text := '';
  2179.   CCICInfoDlg.Edit2.Text := '';
  2180.   CCICInfoDlg.Edit3.Text := '';
  2181.   { Set IP Address Mode }
  2182.   CCICInfoDlg.Tag := 1;
  2183.   { Show Modally to get the information }
  2184.   CCICInfoDlg.ShowModal;
  2185.   { Reset the info dialog to default conditions }
  2186.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  2187.   CCICInfoDlg.Panel4.Visible := true;
  2188.   CCICInfoDlg.Panel6.Visible := true;
  2189.   CCICInfoDlg.Panel9.Visible := true;
  2190.   CCICInfoDlg.Panel8.Visible := true;
  2191.   CCICInfoDlg.BitBtn2.Visible := true;
  2192.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  2193.   CCICInfoDlg.Button2.Visible := true;
  2194.   CCICInfoDlg.Button3.Visible := true;
  2195.   CCICInfoDlg.Button4.Visible := true;
  2196.   CCICInfoDlg.Panel2.Caption := '             Name:';
  2197.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  2198.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  2199.   CCICInfoDlg.Edit1.Text := '';
  2200.   CCICInfoDlg.Edit2.Text := '';
  2201.   CCICInfoDlg.Edit3.Text := '';
  2202. end;
  2203.  
  2204. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  2205. begin
  2206.   { Set up the FTP Data displays }
  2207.   SetupFTPSiteLists;
  2208.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  2209.   TheFTPComponent.Parent := CCInetCCForm;
  2210. end;
  2211.  
  2212. procedure TCCINetCCForm.FormResize(Sender: TObject);
  2213. begin
  2214.   { Use tag vector to determine what to do }
  2215.   case Tag of
  2216.     { if FTP , make sure two list boxes are same height }
  2217.     2 : Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  2218.   end;
  2219. end;
  2220.  
  2221. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  2222. begin
  2223.   { Show Modally to get the information }
  2224.   CCICInfoDlg.ShowModal;
  2225. end;
  2226.  
  2227. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  2228. begin
  2229.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  2230.   CCICPrefsDlg.Tag := 2;
  2231.   CCICPrefsDlg.ShowModal;
  2232. end;
  2233.  
  2234. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  2235. var Counter_1 : Integer;
  2236. begin
  2237.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  2238.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  2239.   begin
  2240.     for Counter_1 := 1 to TheAnonRedialVector do
  2241.     begin
  2242.       DoFTPConnection( PConnectionsRecord(
  2243.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  2244.       if TheFTPComponent.Connection_Established then exit;
  2245.     end;
  2246.   end
  2247.   else DoFTPConnection( PConnectionsRecord(
  2248.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  2249. end;
  2250.  
  2251. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  2252. begin
  2253.   case Tag of
  2254.     2 : begin
  2255.           if not TheFTPComponent.Connection_Established then
  2256.            ConnectToSite1Click( Self ) else
  2257.            begin
  2258.              DoFTPDisconnect;
  2259.              TheFTPComponent.Connection_Established := false;
  2260.              DisableFTPMenus;
  2261.            end;
  2262.         end;
  2263.   end;
  2264. end;
  2265.  
  2266. procedure TCCINetCCForm.ViewasText1Click(Sender: TObject);
  2267. begin
  2268.   { Assume valid FTP component and have it send its text into the progress text}
  2269.   TheFTPComponent.GetRemoteDirectoryListingToMemo;
  2270. end;
  2271.  
  2272. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  2273. begin
  2274.   DoFTPDisconnect;
  2275.   DisableFTPMenus;
  2276. end;
  2277.  
  2278. procedure TCCINetCCForm.EnableFTPMenus;
  2279. begin
  2280.   Button1.Caption := 'Disconnect';
  2281.   ConnectToSite1.Enabled := false;
  2282.   Disconnect1.Enabled := true;
  2283.   Directory1.Enabled := true;
  2284.   UploadMarked1.Enabled := true;
  2285.   DownloadMarked1.Enabled := true;
  2286. end;
  2287.  
  2288. procedure TCCINetCCForm.DisableFTPMenus;
  2289. begin
  2290.   Button1.Caption := 'Connect';
  2291.   ConnectToSite1.Enabled := true;
  2292.   Disconnect1.Enabled := false;
  2293.   Directory1.Enabled := false;
  2294.   UploadMarked1.Enabled := false;
  2295.   DownloadMarked1.Enabled := false;
  2296. end;
  2297.  
  2298. procedure TCCINetCCForm.ToDisplay1Click(Sender: TObject);
  2299. var Counter_1 : Integer;
  2300. begin
  2301.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  2302.   begin
  2303.     if Listbox1.Selected[ Counter_1 ] then
  2304.     begin
  2305.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  2306.       TheFTPComponent.
  2307.        ReceiveASCIIRemoteFileToMemo( Listbox1.Items[ Counter_1 ] );
  2308.     end;
  2309.   end;
  2310. end;
  2311.  
  2312. procedure TCCINetCCForm.Change1Click(Sender: TObject);
  2313. var TheDir : string;
  2314. begin
  2315.   if ListBox1.ItemIndex = -1 then exit;
  2316.   TheDir := ListBox1.Items[ ListBox1.ItemIndex ];
  2317.   if TheFTPComponent.SetRemoteDirectory( TheDir ) then
  2318.   begin
  2319.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir ); 
  2320.     { Put up remote directory via PWD and strip quotes }
  2321.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  2322.     { Get the listings of directories and exit OK }
  2323.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  2324.   end;
  2325. end;
  2326.  
  2327. procedure TCCINetCCForm.ChangeLocal1Click(Sender: TObject);
  2328. var TheDir : string;
  2329. begin
  2330.   if ListBox2.ItemIndex = -1 then exit;
  2331.   TheDir := ListBox2.Items[ ListBox2.ItemIndex ];
  2332.   TheDir := TheFTPComponent.StripBrackets( TheDir );
  2333.   if TheDir = '..' then
  2334.   begin
  2335.     ChDir( TheDir );
  2336.   end
  2337.   else
  2338.   begin
  2339.     TheDir := ExpandFileName( TheDir );
  2340.     ChDir( TheDir );
  2341.   end;
  2342.   TheFTPComponent.GetLocalDirectoryAndListing( TheDir , Listbox2 );
  2343.   if Label5.Canvas.TextWidth( TheDir ) > Label5.Width then
  2344.    TheDir := TheFTPComponent.GetShortPathName( TheDir );
  2345.   Label5.Caption := TheDir;
  2346. end;
  2347.  
  2348. procedure TCCINetCCForm.ListBox1DblClick(Sender: TObject);
  2349. begin
  2350.   case Tag of
  2351.     2 : begin
  2352.           case DefaultDownLoadVector of
  2353.             3 : Change1Click( Self );
  2354.           end;
  2355.         end;
  2356.   end;
  2357. end;
  2358.  
  2359. procedure TCCINetCCForm.ListBox2DblClick(Sender: TObject);
  2360. begin
  2361.   case Tag of
  2362.     2 : begin
  2363.           case DefaultDownLoadVector of
  2364.             3 : ChangeLocal1Click( Self );
  2365.           end;
  2366.         end;
  2367.   end;
  2368. end;
  2369.  
  2370. end.
  2371.